home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / perlivp < prev    next >
Text File  |  2009-10-01  |  12KB  |  442 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.         if $running_under_some_shell;
  4.  
  5. # perlivp v5.10.0
  6.  
  7. sub usage {
  8.     warn "@_\n" if @_;
  9.     print << "    EOUSAGE";
  10. Usage:
  11.  
  12.     $0 [-a] [-p] [-v] | [-h]
  13.  
  14.     -a Run all tests (default is to skip .ph tests)
  15.     -p Print a preface before each test telling what it will test.
  16.     -v Verbose mode in which extra information about test results
  17.        is printed.  Test failures always print out some extra information
  18.        regardless of whether or not this switch is set.
  19.     -h Prints this help message.
  20.     EOUSAGE
  21.     exit;
  22. }
  23.  
  24. use vars qw(%opt); # allow testing with older versions (do not use our)
  25.  
  26. @opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
  27.  
  28. while ($ARGV[0] =~ /^-/) {
  29.     $ARGV[0] =~ s/^-//; 
  30.     for my $flag (split(//,$ARGV[0])) {
  31.         usage() if '?' =~ /\Q$flag/;
  32.         usage() if 'h' =~ /\Q$flag/;
  33.         usage() if 'H' =~ /\Q$flag/;
  34.         usage("unknown flag: `$flag'") unless 'HhPpVva' =~ /\Q$flag/;
  35.         warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
  36.     } 
  37.     shift;
  38. }
  39.  
  40. $opt{p}++ if $opt{P};
  41. $opt{v}++ if $opt{V};
  42.  
  43. my $pass__total = 0;
  44. my $error_total = 0;
  45. my $tests_total = 0;
  46.  
  47. my $perlpath = '/usr/bin/perl';
  48. my $useithreads = 'define';
  49.  
  50. print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
  51.  
  52. if (-x $perlpath) {
  53.     print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
  54.     print "ok 1\n";
  55.     $pass__total++;
  56. }
  57. else {
  58.     print "# Perl binary `$perlpath' does not appear executable.\n";
  59.     print "not ok 1\n";
  60.     $error_total++;
  61. }
  62. $tests_total++;
  63.  
  64.  
  65. print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
  66.  
  67. my $ivp_VERSION = "5.010000";
  68.  
  69. if ($ivp_VERSION eq $]) {
  70.     print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
  71.     print "ok 2\n";
  72.     $pass__total++;
  73. }
  74. else {
  75.     print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
  76.     print "not ok 2\n";
  77.     $error_total++;
  78. }
  79. $tests_total++;
  80.  
  81.  
  82. print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
  83.  
  84. my $INC_total = 0;
  85. my $INC_there = 0;
  86. foreach (@INC) {
  87.     next if $_ eq '.'; # skip -d test here
  88.     next if m|/usr/local|; # not shipped on Debian
  89.     if ($^O eq 'MacOS') {
  90.         next if $_ eq ':'; # skip -d test here
  91.         next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
  92.     }
  93.     if (-d $_) {
  94.         print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
  95.         $INC_there++;
  96.     }
  97.     else {
  98.         print "# Perl \@INC directory `$_' does not appear to exist.\n";
  99.     }
  100.     $INC_total++;
  101. }
  102. if ($INC_total == $INC_there) {
  103.     print "ok 3\n";
  104.     $pass__total++;
  105. }
  106. else {
  107.     print "not ok 3\n";
  108.     $error_total++;
  109. }
  110. $tests_total++;
  111.  
  112.  
  113. print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
  114.  
  115. my $needed_total = 0;
  116. my $needed_there = 0;
  117. foreach (qw(Config.pm ExtUtils/Installed.pm)) {
  118.     $@ = undef;
  119.     $needed_total++;
  120.     eval "require \"$_\";";
  121.     if (!$@) {
  122.         print "## Module `$_' appears to be installed.\n" if $opt{'v'};
  123.         $needed_there++;
  124.     }
  125.     else {
  126.         print "# Needed module `$_' does not appear to be properly installed.\n";
  127.     }
  128.     $@ = undef;
  129. }
  130. if ($needed_total == $needed_there) {
  131.     print "ok 4\n";
  132.     $pass__total++;
  133. }
  134. else {
  135.     print "not ok 4\n";
  136.     $error_total++;
  137. }
  138. $tests_total++;
  139.  
  140.  
  141. print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
  142.  
  143. use Config;
  144.  
  145. my $extensions_total = 0;
  146. my $extensions_there = 0;
  147. if (defined($Config{'extensions'})) {
  148.     my @extensions = split(/\s+/,$Config{'extensions'});
  149.     foreach (@extensions) {
  150.         next if ($_ eq '');
  151.         if ( $useithreads !~ /define/i ) {
  152.             next if ($_ eq 'threads');
  153.             next if ($_ eq 'threads/shared');
  154.         }
  155.     # that's a distribution name, not a module name
  156.     next if /^IO_Compress_(?:Zlib|Base)$/;
  157.         next if $_ eq 'Devel/DProf'; 
  158.     # test modules
  159.     next if $_ eq 'XS/APItest';
  160.     next if $_ eq 'XS/Typemap';
  161.            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
  162.            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
  163.            # DProf: run perl with -d to use DProf.
  164.            # Compilation failed in require at (eval 1) line 1.
  165.         eval " require \"$_.pm\"; ";
  166.         if (!$@) {
  167.             print "## Module `$_' appears to be installed.\n" if $opt{'v'};
  168.             $extensions_there++;
  169.         }
  170.         else {
  171.             print "# Required module `$_' does not appear to be properly installed.\n";
  172.             $@ = undef;
  173.         }
  174.         $extensions_total++;
  175.     }
  176.  
  177.     # A silly name for a module (that hopefully won't ever exist).
  178.     # Note that this test serves more as a check of the validity of the
  179.     # actuall required module tests above.
  180.     my $unnecessary = 'bLuRfle';
  181.  
  182.     if (!grep(/$unnecessary/, @extensions)) {
  183.         $@ = undef;
  184.         eval " require \"$unnecessary.pm\"; ";
  185.         if ($@) {
  186.             print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
  187.         }
  188.         else {
  189.             print "# Unnecessary module `$unnecessary' appears to be installed.\n";
  190.             $extensions_there++;
  191.         }
  192.     }
  193.     $@ = undef;
  194. }
  195. if ($extensions_total == $extensions_there) {
  196.     print "ok 5\n";
  197.     $pass__total++;
  198. }
  199. else {
  200.     print "not ok 5\n";
  201.     $error_total++;
  202. }
  203. $tests_total++;
  204.  
  205.  
  206. print "## Checking installations of later additional extensions.\n" if $opt{'p'};
  207.  
  208. use ExtUtils::Installed;
  209.  
  210. my $installed_total = 0;
  211. my $installed_there = 0;
  212. my $version_check = 0;
  213. my $installed = ExtUtils::Installed -> new();
  214. my @modules = $installed -> modules();
  215. my @missing = ();
  216. my $version = undef;
  217. for (@modules) {
  218.     $installed_total++;
  219.     # Consider it there if it contains one or more files,
  220.     # and has zero missing files,
  221.     # and has a defined version
  222.     $version = undef;
  223.     $version = $installed -> version($_);
  224.     if ($version) {
  225.         print "## $_; $version\n" if $opt{'v'};
  226.         $version_check++;
  227.     }
  228.     else {
  229.         print "# $_; NO VERSION\n" if $opt{'v'};
  230.     }
  231.     $version = undef;
  232.     @missing = ();
  233.     @missing = $installed -> validate($_);
  234.  
  235.     # .bs files are optional
  236.     @missing = grep { ! /\.bs$/ } @missing;
  237.     # man files are often compressed
  238.     @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
  239.  
  240.     if ($#missing >= 0) {
  241.         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
  242.         print '# ',join(' ',@missing),"\n";
  243.     }
  244.     elsif ($#missing == -1) {
  245.         $installed_there++;
  246.     }
  247.     @missing = ();
  248. }
  249. if (($installed_total == $installed_there) && 
  250.     ($installed_total == $version_check)) {
  251.     print "ok 6\n";
  252.     $pass__total++;
  253. }
  254. else {
  255.     print "not ok 6\n";
  256.     $error_total++;
  257. }
  258. $tests_total++;
  259.  
  260.  
  261. if ($opt{'a'}) {
  262. print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
  263. my $ph_there = 0;
  264. my $var = undef;
  265. my $val = undef;
  266. my $h_file = undef;
  267. # Just about "any" C implementation ought to have a stdio.h (even if 
  268. # Config.pm may not list a i_stdio var).
  269. my @ph_files = qw(stdio.ph);
  270. # Add the ones that we know that perl thinks are there:
  271. while (($var, $val) = each %Config) {
  272.     if ($var =~ m/i_(.+)/ && $val eq 'define') {
  273.         $h_file = $1;
  274.     # Some header and symbol names don't match for hysterical raisins.
  275.     $h_file = 'arpa/inet'    if $h_file eq 'arpainet';
  276.     $h_file = 'netinet/in'   if $h_file eq 'niin';
  277.     $h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
  278.     $h_file = 'sys/resource' if $h_file eq 'sysresrc';
  279.     $h_file = 'sys/select'   if $h_file eq 'sysselct';
  280.     $h_file = 'sys/security' if $h_file eq 'syssecrt';
  281.         $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
  282.         # This ought to distinguish syslog from sys/syslog.
  283.         # (NB syslog.ph is heavily used for the DBI pre-requisites).
  284.         $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
  285.         push(@ph_files, "$h_file.ph");
  286.     }
  287. }
  288. #foreach (qw(stdio.ph syslog.ph)) {
  289. foreach (@ph_files) {
  290.     $@ = undef;
  291.     eval "require \"$_\";";
  292.     if (!$@) {
  293.         print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
  294.         $ph_there++;
  295.     }
  296.     else {
  297.         print "# Perl header `$_' does not appear to be properly installed.\n";
  298.     }
  299.     $@ = undef;
  300. }
  301.  
  302. if (scalar(@ph_files) == $ph_there) {
  303.     print "ok 7\n";
  304.     $pass__total++;
  305. }
  306. else {
  307.     print "not ok 7\n";
  308.     $error_total++;
  309. }
  310. $tests_total++;
  311. }
  312. else {
  313.     print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
  314. }
  315.  
  316. # Final report (rather than feed ousrselves to Test::Harness::runtests()
  317. # we simply format some output on our own to keep things simple and
  318. # easier to "fix" - at least for now.
  319.  
  320. if ($error_total == 0 && $tests_total) {
  321.     print "All tests successful.\n";
  322. } elsif ($tests_total==0){
  323.         die "FAILED--no tests were run for some reason.\n";
  324. } else {
  325.     my $rate = 0.0;
  326.     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
  327.     printf " %d/%d subtests failed, %.2f%% okay.\n",
  328.                               $error_total, $tests_total, $rate;
  329. }
  330.  
  331. =head1 NAME
  332.  
  333. perlivp - Perl Installation Verification Procedure
  334.  
  335. =head1 SYNOPSIS
  336.  
  337. B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
  338.  
  339. =head1 DESCRIPTION
  340.  
  341. The B<perlivp> program is set up at Perl source code build time to test the
  342. Perl version it was built under.  It can be used after running:
  343.  
  344.     make install
  345.  
  346. (or your platform's equivalent procedure) to verify that B<perl> and its
  347. libraries have been installed correctly.  A correct installation is verified
  348. by output that looks like:
  349.  
  350.     ok 1
  351.     ok 2
  352.  
  353. etc.
  354.  
  355. =head1 OPTIONS
  356.  
  357. =over 5
  358.  
  359. =item B<-h> help
  360.  
  361. Prints out a brief help message.
  362.  
  363. =item B<-a> run all tests
  364.  
  365. Normally tests for optional features are skipped.  With -a all tests
  366. are executed.
  367.  
  368. =item B<-p> print preface
  369.  
  370. Gives a description of each test prior to performing it.
  371.  
  372. =item B<-v> verbose
  373.  
  374. Gives more detailed information about each test, after it has been performed.
  375. Note that any failed tests ought to print out some extra information whether
  376. or not -v is thrown.
  377.  
  378. =back
  379.  
  380. =head1 DIAGNOSTICS
  381.  
  382. =over 4
  383.  
  384. =item * print "# Perl binary `$perlpath' does not appear executable.\n";
  385.  
  386. Likely to occur for a perl binary that was not properly installed.
  387. Correct by conducting a proper installation.
  388.  
  389. =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
  390.  
  391. Likely to occur for a perl that was not properly installed.
  392. Correct by conducting a proper installation.
  393.  
  394. =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
  395.  
  396. Likely to occur for a perl library tree that was not properly installed.
  397. Correct by conducting a proper installation.
  398.  
  399. =item * print "# Needed module `$_' does not appear to be properly installed.\n";
  400.  
  401. One of the two modules that is used by perlivp was not present in the 
  402. installation.  This is a serious error since it adversely affects perlivp's
  403. ability to function.  You may be able to correct this by performing a
  404. proper perl installation.
  405.  
  406. =item * print "# Required module `$_' does not appear to be properly installed.\n";
  407.  
  408. An attempt to C<eval "require $module"> failed, even though the list of 
  409. extensions indicated that it should succeed.  Correct by conducting a proper 
  410. installation.
  411.  
  412. =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
  413.  
  414. This test not coming out ok could indicate that you have in fact installed 
  415. a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
  416. test may give misleading results with your installation of perl.  If yours
  417. is the latter case then please let the author know.
  418.  
  419. =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
  420.  
  421. One or more files turned up missing according to a run of 
  422. C<ExtUtils::Installed -E<gt> validate()> over your installation.
  423. Correct by conducting a proper installation.
  424.  
  425. =item * print "# Perl header `$_' does not appear to be properly installed.\n";
  426.  
  427. Correct by running B<h2ph> over your system's C header files.  If necessary, 
  428. edit the resulting *.ph files to eliminate perl syntax errors.
  429.  
  430. =back
  431.  
  432. For further information on how to conduct a proper installation consult the 
  433. INSTALL file that comes with the perl source and the README file for your 
  434. platform.
  435.  
  436. =head1 AUTHOR
  437.  
  438. Peter Prymmer
  439.  
  440. =cut
  441.  
  442.